home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / others / ngz.zip / NGZ.INC < prev    next >
Text File  |  1993-05-14  |  8KB  |  321 lines
  1.  
  2.  
  3. { NGZ.INC  ---  Support routines for NGZ.PAS }
  4.  
  5.  
  6. FUNCTION HexB(B : Byte) : str2;
  7. CONST
  8.    HexDigits : ARRAY[0..15] OF CHAR = '0123456789ABCDEF';
  9. BEGIN
  10.    HexB := HexDigits[B SHR 4]+HexDigits[B AND $0F];
  11. END;
  12.  
  13. FUNCTION HexW(W : WORD) : str4;
  14. BEGIN
  15.    HexW := HexB(Hi(W)) + HexB(Lo(W));
  16. END;
  17.  
  18. FUNCTION HexDW(DW : LONGINT) : str8;
  19. BEGIN
  20.    HexDW := HexW((DW AND $FFFF0000) SHR 16)
  21.          + HexW(DW AND $0000FFFF);
  22. END;
  23.  
  24.  
  25. FUNCTION GetW(i : WORD) : WORD;
  26. { Get word from var buf starting at buf[i] }
  27. VAR w : WORD;
  28. BEGIN
  29.    Move(buf[i],w,2);
  30.    GetW := w;
  31. END;
  32.  
  33. FUNCTION GetDW(i : WORD) : DWORD;
  34. { Get dword from var buf }
  35. VAR dw : DWORD;
  36. BEGIN
  37.    Move(buf[i],dw,4);
  38.    GetDW := dw;
  39. END;
  40.  
  41.  
  42. FUNCTION GetW_s(i : WORD) : WORD;
  43. { Get word from var sbuf starting at sbuf[i] }
  44. VAR w : WORD;
  45. BEGIN
  46.    Move(sbuf[i],w,2);
  47.    GetW_s := w;
  48. END;
  49.  
  50. FUNCTION GetDW_s(i : WORD) : DWORD;
  51. { Get dword from var sbuf }
  52. VAR dw : DWORD;
  53. BEGIN
  54.    Move(sbuf[i],dw,4);
  55.    GetDW_s := dw;
  56. END;
  57.  
  58.  
  59. FUNCTION GetStr(i : WORD) : str65;
  60. { Get (plain) asciiz string starting at buf[i],
  61.   only used for non-compressed strings in
  62.   file header }
  63. VAR
  64.    s : str65;
  65.    j : WORD;
  66. BEGIN
  67.    j := 0;
  68.    WHILE buf[i] > 0 DO BEGIN
  69.       Inc(j);
  70.       s[j] := Chr(buf[i]);
  71.       Inc(i);
  72.    END;
  73.    s[0] := Chr(j);
  74.    GetStr := s;
  75. END;
  76.  
  77.  
  78. FUNCTION rpad(s : str100; len : WORD) : str100;
  79. { pad string on right with blanks }
  80. BEGIN
  81.    WHILE Length(s) < len DO
  82.       s := s + #32;
  83.    rpad := s;
  84. END;
  85.  
  86. FUNCTION zeropad(n : WORD) : str3;
  87. { return number as zero-padded digit string }
  88. VAR s : str3; i : WORD;
  89. BEGIN
  90.    Str(n : 3, s);
  91.    FOR i := 1 TO 2 DO
  92.       IF s[i] = #32 THEN s[i] := '0';
  93.    zeropad := s;
  94. END;
  95.  
  96.  
  97. FUNCTION cap(s : str100) : str100;
  98. { convert to uppercase }
  99. VAR i : WORD;
  100. BEGIN
  101.    FOR i := 1 TO Length(s) DO
  102.      IF s[i] IN ['a'..'z'] THEN Dec(s[i],$20);
  103.    cap := s;
  104. END;
  105.  
  106.  
  107. PROCEDURE parse_command(VAR r_c : BYTE;  VAR sce : str79);
  108. { Get args on command line
  109.   Exit: r_c = 0: no errors (sce = input file),
  110.         r_c > 0: no args or bad number }
  111. VAR
  112.    i,j  : WORD;
  113.    test : INTEGER;
  114. BEGIN
  115.    sce := cap(ParamStr(1));             { uppercase }
  116.    cmd := '';
  117.    FOR i := 1 TO ParamCount DO
  118.       cmd := cmd + cap(ParamStr(i)) + ' ';
  119.    is_info_req  := Pos('?',cmd) > 0;
  120.    is_quiet     := Pos('/Q',cmd) > 0;
  121.    is_rept_only := Pos('/R',cmd) > 0;
  122.    is_partial   := Pos('/P',cmd) > 0;
  123.  
  124.    r_c := 0;
  125.    IF is_info_req THEN EXIT;            { info request: skip rest }
  126.  
  127.    r_c := 1;
  128.    IF cmd = '' THEN EXIT;
  129.    IF sce = '' THEN EXIT;
  130.  
  131.    IF is_partial THEN BEGIN
  132.       i := Pos('/P',cmd) + 2;
  133.       j := i;
  134.       WHILE cmd[j] IN ['0'..'9','A'..'F'] DO Inc(j);
  135.       {$IFDEF DEBUG}
  136.          {$R-}
  137.       {$ENDIF}
  138.       Val('$'+Copy(cmd,i,j-i), partial_offs, test);
  139.       {$IFDEF DEBUG}
  140.          {$R+}
  141.       {$ENDIF}
  142.       IF (test > 0) OR (partial_offs < 0) THEN
  143.          EXIT;
  144.    END;
  145.  
  146.    r_c := 0;
  147. END;
  148.  
  149.  
  150. PROCEDURE write_link_file;
  151. { Output file to use with NGML - the menu linker }
  152. VAR i,j : WORD;
  153.     st : str100;
  154. BEGIN
  155.    ASSIGN(linkf, fprefix + dot_LCF);
  156.    REWRITE(linkf);
  157.    WRITELN(linkf, crlf + rpad('!Name:',12) + NG_name + crlf);
  158.    WRITELN(linkf,'!Credits:');
  159.  
  160.    st := '';
  161.    FOR i := 0 TO Pred(credits_num) DO           { suppress empty credits }
  162.       st := st + credits[0];
  163.    IF NOT (st = '') THEN
  164.       FOR i := 0 TO Pred(credits_num) DO
  165.          WRITELN(linkf, credits[i]);
  166.    WRITELN(linkf);
  167.  
  168.    FOR i := 0 TO Pred(no_of_menus) DO BEGIN     { print menus & .NGOs }
  169.       WRITE(linkf, rpad('!Menu:',12));
  170.       WRITELN(linkf, menu[i].toptxt);
  171.       FOR j := 0 TO Pred(menu[i].items) DO BEGIN
  172.          st := menu[i].drop[j].txt;
  173.          WRITELN(linkf, rpad('',12) + rpad(st, Succ(name_len))
  174.            + fprefix + zeropad(menu[i].drop[j].datn) + dot_NGO);
  175.       END;
  176.       WRITELN(linkf);
  177.    END;
  178.    CLOSE(linkf);
  179. END;
  180.  
  181.  
  182. PROCEDURE write_make_file;
  183. { Output file to use with the MAKE utility }
  184. VAR i,j,k : WORD;
  185.     st : str100;
  186. BEGIN
  187.    ASSIGN(makef, fprefix + dot_MAK);
  188.    REWRITE(makef);
  189.    WRITELN(makef, '# Type:  MAKE -f' + fprefix + dot_MAK + crlf);
  190.    WRITELN(makef, dot_ASC + dot_NGO + ':');
  191.    WRITELN(makef, rpad('',12) + 'NGC $<' + crlf);
  192.    WRITE(makef, 'OBJECTS= ');
  193.    k := 9;
  194.    FOR i := 1 TO out_files_num DO
  195.       BEGIN
  196.          WRITE(makef, rpad( fprefix + zeropad(i) + dot_NGO, 14) );
  197.          k := k + 14;
  198.          IF k >= 65 THEN BEGIN
  199.             WRITE(makef,'\' + crlf + rpad('',9));
  200.             k := 9;
  201.          END;
  202.       END;
  203.    WRITELN(makef,crlf+crlf+ 'NEWNG.NG:   $(OBJECTS)');
  204.    WRITELN(makef, rpad('',9) + 'NGML ' + fprefix + dot_LCF);
  205.    CLOSE(makef);
  206. END;
  207.  
  208.  
  209.  
  210.  
  211.  
  212. { ------- Procedures beyond this point are not normally used by NGZ ------- }
  213.  
  214. {         For a verbose, raw, sequential dump of an NG file, edit
  215.           the first 2 lines of NGZ.PAS's main procedure to:
  216.              dump_NG_file('c:\ng\filename.ng','outfile.$$$');
  217.              Halt(0);
  218.           and recompile (TPC ngz).
  219. }
  220.  
  221.  
  222. FUNCTION getNGstr(i:WORD; VAR sz:WORD) : str100; FORWARD;
  223. PROCEDURE read_n_verify_header; FORWARD;
  224. PROCEDURE read_n_decrypt_struc(VAR ID : WORD; varia_too : BOOLEAN); FORWARD;
  225.  
  226. PROCEDURE dump_NG_file(infs,outfs:str100);
  227. VAR outf:TEXT; this_ID:WORD;
  228.  
  229. PROCEDURE dump_menu_struc(VAR f:TEXT);
  230. VAR i,j,it,len : WORD;
  231. BEGIN
  232.    it := getw(4);
  233.    WRITELN(f, crlf,'Menu struc at file offset: ',hexDW(last_read_pos));
  234.    WRITELN(f, 'ID    VarSz Items (4x)  ??');
  235.    WRITE(f, hexW(getW(0)),'  ',hexW(getW(2)),'  ',hexW(it),'  ',
  236.          hexW(getW(6)),'  ');
  237.    FOR i := 8 TO Pred($1A) DO WRITE(f, hexB(buf[i]));
  238.    WRITELN(f);
  239.    WRITELN(f,'Menu title: ' + getNGstr($1A + 4 * Pred(it) + 8 * it, len)  );
  240.    WRITELN(f,'Struc offs, and menu_string:');
  241.    FOR i := 1 TO Pred(it) DO
  242.       BEGIN
  243.          WRITELN(f, hexDW(getDW($1A + 4 * Pred(i)) ) + '   ' +
  244.             getNGstr($1A + getW($1A + 4 * Pred(it) + 8 * Pred(i)),len) );
  245.       END;
  246.    WRITELN(f);
  247. END;  { dump_menu_struc }
  248.  
  249.  
  250. PROCEDURE dump_short_struc(VAR f:TEXT);
  251. VAR i,it,len : WORD;
  252. BEGIN
  253.    it := getw(4);
  254.    WRITELN(f,crlf,'Short struc at file offset: ', hexDW(last_read_pos));
  255.    WRITELN(f,
  256.    'ID    VarSz Items ??    Par#  Parent    Mnu#  Itm#  0         0');
  257.    WRITE(f, hexW(getW(0)),'  ',hexW(getW(2)),'  ',hexW(it),'  ');
  258.    WRITE(f, hexW(getW(6)),'  ',hexW(getW(8)),'  ',hexDW(getDW($0a)),'  ');
  259.    WRITE(f, hexW(getW($0e)),'  ',hexW(getW($10)),'  ');
  260.    WRITELN(f, hexDW(getDW($12)),'  ',hexDW(getDW($16)));
  261.    IF it > 0 THEN BEGIN
  262.       { print 1st short string }
  263.       WRITELN(f, '1st text:'+getNGstr($1A + getW($1A),len) );
  264.       { print pointers }
  265.       WRITELN(f,'Pointers:');
  266.       FOR i := 1 TO it DO
  267.          BEGIN
  268.             WRITE(f, hexDW(getDW($1A + 2 + 6 * Pred(i))),' ');
  269.             IF i MOD 8 = 0 THEN WRITELN(f);
  270.          END;
  271.       WRITELN(f,crlf);
  272.    END;
  273. END;  { dump_short_struc }
  274.  
  275.  
  276. PROCEDURE dump_long_struc(VAR f:TEXT);
  277. VAR i,it,len : WORD;
  278. BEGIN
  279.    it := getW(4);
  280.    WRITELN(f, 'Long struc at file offset: ',hexDW(last_read_pos));
  281.    WRITELN(f,
  282.    'ID    VarSz Lines SAof  Par#  Parent    Mnu#  Itm#  PrevPtr   NextPtr');
  283.    WRITE(f, hexW(getW(0)),'  ',hexW(getW(2)),'  ',hexW(it),'  ');
  284.    WRITE(f, hexW(getW(6)),'  ',hexW(getW(8)),'  ',hexDW(getDW($0a)),'  ');
  285.    WRITE(f, hexW(getW($0e)),'  ',hexW(getW($10)),'  ');
  286.    WRITELN(f, hexDW(getDW($12)),'  ',hexDW(getDW($16)));
  287.    { display 1st 2 strings }
  288.    WRITELN(f, getNGstr($1A,len));
  289.    IF it > 1 THEN
  290.       WRITELN(f, getNGstr($1A+Succ(len),len));
  291.    WRITELN(f);
  292. END;  { dump_long_struc }
  293.  
  294.  
  295. BEGIN  { dump_NG_file }
  296.    ASSIGN(NGf,infs);
  297.    FileMode := 0;
  298.    RESET(NGf,1);
  299.  
  300.    ASSIGN(outf,outfs);
  301.    SetTextBuf(outf, textbuffer);
  302.    REWRITE(outf);
  303.  
  304.    read_n_verify_header;
  305.    WRITELN(outf,infs + crlf + getstr(8));
  306.    REPEAT
  307.       read_n_decrypt_struc(this_ID,True);
  308.       CASE this_ID OF
  309.          0 : dump_short_struc(outf);
  310.          1 : dump_long_struc(outf);
  311.          2 : dump_menu_struc(outf);
  312.         99 : { at Eof: see note at read_n_decrypt } ;
  313.       END;
  314.       WRITE('.');
  315.    UNTIL Eof(NGf);
  316.    CLOSE(NGf); CLOSE(outf);
  317.    WRITELN;
  318. END;
  319.  
  320. { eof }
  321.